home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol067 / mailmgr.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-14  |  10.3 KB  |  251 lines
  1. 10 REM Program MAILMGR - Mailing List Manager
  2. 20 REM Written by Warren Cotton
  3. 30 REM Date Written 06/10/84
  4. 99 '
  5. 1010 SCREEN 0,0,0:CLEAR
  6. 1020 KEY OFF: DEFINT A-Z: CLS
  7. 1030 OPEN "SCRN:" FOR OUTPUT AS #2
  8. 1040 DIM R$(21,3),H$(7)
  9. 1050 H$(0)="REC #": Q$=CHR$(34)
  10. 1060 FOR J=1 TO 7: READ H$(J): NEXT
  11. 1070 DATA LAST NAME,FIRST NAME,COMPANY,STREET ADDR,CITY,STATE,ZIP CODE
  12. 1080 ON ERROR GOTO 1200: GOSUB 8000
  13. 1100 REM ===> LISTNAME File Routines
  14. 1110 CLS: PRINT "SELECT FROM:": PRINT
  15. 1120 FOR J=1 TO NR: PRINT J" "R$(J,0): NEXT: PRINT
  16. 1130 PRINT J" CREATE A NEW FILE"
  17. 1140 IF J>1 THEN PRINT J+1" DELETE A FILE":PRINT
  18. 1150 INPUT"NUMBER";D: IF D<1 OR D>J+1 THEN GOSUB 9200: GOTO 1150
  19. 1160 IF D<J THEN 1320
  20. 1170 ON D-NR GOTO 1220,1800
  21. 1200 RESUME 1210    'target of error
  22. 1210 ON ERROR GOTO 0
  23. 1220 IF J=0 THEN J=1
  24. 1230 PRINT: INPUT"NAME FOR NEW FILE: ",R$(D,0)
  25. 1240 IF LEN(R$(D,0))>8 THEN PRINT"MAX LENGTH 8 CHARACTERS": GOTO 1230
  26. 1250 FOR I=1 TO D-1: IF R$(I,0)<>R$(D,0) THEN NEXT: PRINT: GOTO 1280
  27. 1260 PRINT"FILE "Q$+R$(D,0)+Q$" ALREADY EXISTS.": GOTO 1230
  28. 1280 FOR I=1 TO 3: PRINT"ENTER DEFAULT "H$(I+4); TAB(24): INPUT R$(D,I): NEXT
  29. 1290 PRINT: PRINT"ACCESS DEFAULT BY ENTERING '*' IN FIELD": PRINT
  30. 1300 NR=D: GOSUB 8200
  31. 1320 PRINT: MEM#=FRE(0)
  32. 1330 PRINT "AVAILABLE BYTES OF MEMORY ="FRE(0)
  33. 1340 PRINT: AVGREC=60: B=INT(MEM#/AVGREC)-10
  34. 1350 PRINT"ASSUMING AN AVERAGE OF"AVGREC"CHARS/RECORD,"
  35. 1360 PRINT"MEMORY CAN HOLD"B"RECORDS."
  36. 1370 DIM N$(B,7),R(B): NR=0
  37. 1380 ON ERROR GOTO 1700
  38. 1400 OPEN R$(D,0)+".LST" FOR INPUT AS #1
  39. 1410 ON ERROR GOTO 0
  40. 1420 PRINT: PRINT"LOADING FILE "R$(D,0)
  41. 1430 INPUT #1,NR: FOR J=1 TO NR: FOR I=1 TO 7
  42. 1440  LINE INPUT#1,N$(J,I)
  43. 1450 NEXT I,J: CLOSE #1: GOTO 2000
  44. 1700 REM ===> No maillist file
  45. 1710 RESUME 1720   'target of error
  46. 1720 ON ERROR GOTO 0
  47. 1730 PRINT: PRINT"FILE "Q$+R$(D,0)+Q$" ESTABLISHED"
  48. 1740 PRINT: INPUT"READY TO ENTER RECORDS";S$
  49. 1750 IF S$="Y" OR S$="y" THEN 6200 ELSE 2000
  50. 1800 REM ===> Delete a Data Base
  51. 1810 PRINT: INPUT"FILE # TO DELETE";D
  52. 1820 IF D<1 OR D>J-1 THEN GOSUB 9200: GOTO 1810
  53. 1830 CLS: LOCATE 9,1
  54. 1840 PRINT"READY TO DELETE "Q$+R$(D,0)+Q$".": PRINT
  55. 1850 PRINT"ONCE DELETED, THIS DATA CANNOT BE RECOVERED."
  56. 1860 INPUT"ARE YOU SURE YOU WANT TO DELETE IT (Y/N)";S$
  57. 1870 IF S$<>"Y" AND S$<>"y" THEN 1100
  58. 1940 FL$=R$(D,0): FE$=".LST": GOSUB 8300
  59. 1960 GOSUB 8000: IF NR=1 THEN FL$="LISTNAME": FE$="": GOSUB 8300: GOTO 9400
  60. 1970 FOR J=D TO NR-1: FOR I=0 TO 3: R$(J,I)=R$(J+1,I): NEXT I,J: NR=NR-1
  61. 1980 PRINT: PRINT"DELETION COMPLETED": GOSUB 8200: GOTO 1100
  62. 2000 REM ===> Main Menu
  63. 2010 CLS: PRINT"*** MAILING LIST MANAGER ***": PRINT
  64. 2020 PRINT"CURRENT FILE:    "R$(D,0)
  65. 2030 PRINT"CURRENT RECORD COUNT:"NR: PRINT
  66. 2040 PRINT" 1  SELECT NEW FILE"
  67. 2050 PRINT" 2  SEARCH DATA"
  68. 2060 PRINT" 3  REPORTS"
  69. 2070 PRINT" 4  SORT FILE"
  70. 2080 PRINT" 5  ADD/CHANGE/DELETE RECORDS"
  71. 2090 PRINT" 6  QUIT": PRINT: CD=0
  72. 2100 INPUT"NUMBER";S: IF S<1 OR S>6 THEN GOSUB 9200: GOTO 2100
  73. 2110 ON S GOTO 9400,2400,3000,5000,6000,9500
  74. 2400 REM ===> Search Data
  75. 2410 L=0
  76. 2420 CLS: PRINT"SEARCH ANY OF THE FOLLOWING FIELDS:": PRINT: GOSUB 7700
  77. 2430 INPUT"NUMBER";S: IF S<0 OR S>7 THEN GOSUB 9200: GOTO 2430
  78. 2440 PRINT: PRINT"ENTER THE ";H$(S);: INPUT" TO BE FOUND: ",S$
  79. 2450 GOSUB 2700: IF PF THEN PRINT"SEARCHING..." ELSE CLS
  80. 2460 IF S=0 THEN J=VAL(S$): GOSUB 2800: GOTO 2500
  81. 2470 FOR J=1 TO NR: N$(J,0)=STR$(J)
  82. 2480  I=INSTR(N$(J,S),S$): IF I>0 THEN GOSUB 2800
  83. 2490 NEXT J: IF PF THEN LPRINT CHR$(12);
  84. 2500 INPUT"SEARCH FINISHED -- MORE SEARCHES (Y/N)";L$
  85. 2510 IF L$="Y" OR L$="y" THEN 2420 ELSE 2000
  86. 2600 REM ===> List All Records
  87. 2610 IF PF THEN PRINT"PRINTING..." ELSE CLS
  88. 2620 FOR J=1 TO NR: GOSUB 2800: NEXT
  89. 2630 IF PF THEN LPRINT CHR$(12);
  90. 2640 INPUT"END OF LIST   -RETURN- FOR MENU",L$: GOTO 2000
  91. 2700 REM ===> Printer selection
  92. 2710 CLOSE #2: PRINT: INPUT"OUTPUT TO PRINTER (Y/N)";L$
  93. 2720 IF L$="Y" OR L$="y" THEN OPEN "LPT1:" FOR OUTPUT AS #2: LM=60: PF=1                                 ELSE OPEN "SCRN:" FOR OUTPUT AS #2: LM=20: PF=0
  94. 2730 L=0: RETURN
  95. 2800 REM ===> Print a Record
  96. 2810 PRINT #2,H$(0)": ";J
  97. 2820 FOR I=1 TO 7: PRINT #2,I" "H$(I)":"; TAB(18) N$(J,I): NEXT
  98. 2830 PRINT #2,: L=L+9: IF L+7<LM THEN 2890
  99. 2840 IF PF THEN LPRINT CHR$(12);
  100. 2850 PRINT "-RETURN- TO CONTINUE; -ESC- FOR MAIN MENU";
  101. 2860 L$=INKEY$: IF L$="" THEN 2860
  102. 2870 IF L$=CHR$(27) THEN 2000 ELSE IF L$<>CHR$(13) THEN 2860
  103. 2880 L=0: IF PF THEN PRINT: PRINT"PRINTING..." ELSE CLS
  104. 2890 RETURN
  105. 3000 REM ===> Reports
  106. 3010 CLS: PRINT"SELECT FROM:": PRINT
  107. 3020 PRINT" 0  RETURN TO MAIN MENU"
  108. 3030 PRINT" 1  LIST ALL RECORDS W/ HEADERS"
  109. 3040 PRINT" 2  FILE LISTING, 2-UP"
  110. 3050 PRINT" 3  MAILING LABELS": PRINT
  111. 3060 INPUT"NUMBER";S: IF S<0 OR S>3 THEN GOSUB 9200: GOTO 3060
  112. 3070 IF S>0 THEN GOSUB 2700
  113. 3080 ON S GOTO 2600,3200,3100: GOTO 2000
  114. 3100 REM Mailing Labels
  115. 3110 PRINT: INPUT"HOW MANY LINES BETWEEN LABELS";E
  116. 3115 IF PF THEN PRINT"PRINTING..."
  117. 3120 FOR J=1 TO NR
  118. 3130  IF N$(J,2)="" THEN PRINT #2,N$(J,1) ELSE PRINT #2,N$(J,2)+" "+N$(J,1)
  119. 3140  IF N$(J,3)="" THEN L=3 ELSE PRINT #2,N$(J,3): L=4
  120. 3150  PRINT #2,N$(J,4)
  121. 3160  PRINT #2,N$(J,5)+", "+N$(J,6)+"  "+N$(J,7)
  122. 3170  FOR I=L TO 4+E: PRINT #2,: NEXT I
  123. 3180 NEXT J: GOTO 2000
  124. 3200 REM 2-up file listing
  125. 3210 I=(LM\5): J=1
  126. 3220 IF PF THEN PRINT"PRINTING..." ELSE CLS
  127. 3230 MR=J+I: WHILE J<MR
  128. 3240  K=J+I
  129. 3250  PRINT #2,N$(J,2)+" "+N$(J,1) TAB(35) N$(K,2)+" "+N$(K,1)
  130. 3260  IF N$(J,3)="" AND N$(K,3)="" THEN N=3 ELSE N=4: PRINT #2,N$(J,3) TAB(35)        N$(K,3)
  131. 3270  PRINT #2,N$(J,4) TAB(35) N$(K,4)
  132. 3280  PRINT #2,N$(J,5)+", "+N$(J,6)+"  "+N$(J,7)                                       TAB(35) N$(K,5)+", "+N$(K,6)+"  "+N$(K,7)
  133. 3290  PRINT #2,: IF N=3 THEN PRINT #2,
  134. 3300  J=J+1: WEND
  135. 3310 IF J+I<NR THEN GOSUB 2840: J=MR+I: GOTO 3230
  136. 3320 IF PF THEN LPRINT CHR$(12);
  137. 3330 INPUT"END OF REPORT   -RETURN- FOR MENU",L$: GOTO 2000
  138. 5000 REM ===> Sort Data Base
  139. 5010 CLS: MF=1: GOSUB 7700
  140. 5020 INPUT"SORT ON WHICH FIELD #";S: IF S<1 OR S>7 THEN GOSUB 9200: GOTO 5020
  141. 5060 PRINT: PRINT "SORTING ..."
  142. 5070 FOR I=1 TO NR: R(I)=0: NEXT
  143. 5080 FOR I=1 TO NR: FOR J=1 TO NR
  144. 5090  IF S=7 THEN 5120
  145. 5100  IF N$(I,S)>=N$(J,S) THEN R(I)=R(I)+1
  146. 5110  GOTO 5130
  147. 5120  IF VAL(N$(I,7))>=VAL(N$(J,7)) THEN R(I)=R(I)+1
  148. 5130 NEXT J,I
  149. 5140 PRINT "SORT PHASE 1 FINISHED"
  150. 5150 FOR I=NR TO 1 STEP -1:FOR J=NR TO 1 STEP -1
  151. 5160  IF I<>J THEN IF R(I)=R(J) THEN R(J)=R(J)-1
  152. 5170 NEXT J,I
  153. 5180 PRINT"SORT PHASE 2 FINISHED": J=1
  154. 5190 IF R(J)=J THEN J=J+1:GOTO 5190
  155. 5200 IF J>=NR THEN 5230
  156. 5210 FOR I=1 TO 7: SWAP N$(R(J),I),N$(J,I): NEXT
  157. 5220 SWAP R(R(J)),R(J): GOTO 5190
  158. 5230 BEEP: PRINT"SAVE THE ";R$(D,0);" FILE SORTED BY ";H$(S);: INPUT L$
  159. 5240 IF L$="Y" OR L$="y" THEN GOSUB 8100
  160. 5250 GOTO 2000
  161. 6000 REM ===> File modification sub-menu
  162. 6010 CLS: PRINT"*** ADD/CHANGE/DELETE RECORDS ***": PRINT
  163. 6020 PRINT"CURRENT FILE:    "R$(D,0)
  164. 6030 PRINT"CURRENT RECORD COUNT:"NR
  165. 6040 PRINT"ROOM FOR"B-NR"MORE RECORDS": PRINT
  166. 6050 PRINT" 0  RETURN TO MAIN MENU"
  167. 6060 PRINT" 1  ENTER RECORDS"
  168. 6070 PRINT" 2  CHANGE DATA"
  169. 6080 PRINT" 3  DELETE RECORDS": PRINT
  170. 6100 INPUT"NUMBER";S: IF S<0 OR S>3 THEN GOSUB 9200: GOTO 6100
  171. 6110 ON S GOTO 6200,6400,6600: GOTO 6900
  172. 6200 REM ===> Enter Records
  173. 6210 CLS
  174. 6220 PRINT"NULL LAST NAME WILL END ENTRY": PRINT
  175. 6230 NR=NR+1: PRINT"ENTERING RECORD #"NR: PRINT
  176. 6240 FOR I=1 TO 7: PRINT H$(I)":"; TAB(14)
  177. 6250  LINE INPUT I$
  178. 6260  IF I=1 AND I$="" THEN NR=NR-1: GOTO 6000
  179. 6270  IF I>4 AND I$="*" THEN N$(NR,I)=R$(D,I-4) ELSE N$(NR,I)=I$
  180. 6280 NEXT I: PRINT: CD=1: GOTO 6220
  181. 6400 REM ===> Change Data
  182. 6410 PRINT: INPUT"REC # TO BE CHANGED";J
  183. 6420 CLS: PRINT H$(0);": ";J
  184. 6430 FOR I=1 TO 7: PRINT I" "H$(I)":" TAB(18) N$(J,I): NEXT: PRINT
  185. 6440 INPUT"FIELD # TO BE CHANGED (0 FOR NO CHANGE)";S
  186. 6450 IF S<1 THEN 6500 ELSE IF S>7 THEN GOSUB 9200: GOTO 6440
  187. 6460 PRINT: PRINT"FROM "H$(S)": "N$(J,S)
  188. 6470 PRINT" TO  "H$(S)": ";
  189. 6480 LINE INPUT I$: PRINT: CD=1
  190. 6490 IF S>4 AND I$="*" THEN N$(J,S)=R$(D,S-4) ELSE N$(J,S)=I$
  191. 6500 PRINT"(-ESC- TO END CHANGES, -RETURN- FOR NEXT HIGHER REC #)"
  192. 6510 PRINT"NEXT REC # TO CHANGE? ";: LOCATE ,,1: A$=""
  193. 6520 L$=INKEY$: IF L$="" THEN 6520
  194. 6530 IF L$=CHR$(27) THEN 6000
  195. 6540 IF L$=CHR$(13) THEN IF LEN(A$)=0 THEN J=J+1: GOTO 6420                          ELSE J=VAL(A$): GOTO 6420
  196. 6550 IF L$=CHR$(8) THEN LOCATE ,POS(0)-1: PRINT" ";: LOCATE ,POS(0)-1,1:             IF LEN(A$)>0 THEN A$=LEFT$(A$,LEN(A$)-1): GOTO 6520 ELSE 6520
  197. 6560 IF ASC(L$)>=48 AND ASC(L$)<=57 THEN PRINT L$;: A$=A$+L$: ELSE BEEP
  198. 6570 GOTO 6520
  199. 6600 REM ===> Delete Records
  200. 6605 CLS
  201. 6610 INPUT"ENTER REC # TO DELETE (-RETURN- TO END DELETION): ",DR
  202. 6620 IF DR<1 THEN 6000 ELSE IF DR>NR THEN GOSUB 9200: GOTO 6610
  203. 6630 PRINT: PRINT H$(0);": ";DR
  204. 6640 FOR I=1 TO 7: PRINT I" "H$(I)":"; TAB(18) N$(DR,I): NEXT
  205. 6650 PRINT: INPUT"DELETE THIS RECORD (Y/N)";L$
  206. 6660 IF L$="Y" OR L$="y" THEN 6670 ELSE PRINT: GOTO 6610
  207. 6670 FOR J=DR TO NR-1: FOR I=1 TO 7
  208. 6680  N$(J,I)=N$(J+1,I): NEXT I,J: NR=NR-1: CD=1
  209. 6690 PRINT: PRINT">>> RECORD NUMBER"DR"DELETED <<<": PRINT: GOTO 6610
  210. 6900 REM ===> Return to Main Menu
  211. 6910 IF CD=1 THEN GOSUB 8100
  212. 6920 GOTO 2000
  213. 7700 REM ===> Sub-Menu of Field Headers
  214. 7710 PRINT "SELECT FROM:":PRINT
  215. 7720 IF MF=0 THEN PRINT MF;" ";H$(0)
  216. 7730 FOR I=1 TO 7: PRINT I;" ";H$(I): NEXT
  217. 7740 PRINT: MF=0: RETURN
  218. 8000 REM ===> Read Listname File
  219. 8020 OPEN "LISTNAME" FOR INPUT AS #1
  220. 8030 ON ERROR GOTO 0
  221. 8040 INPUT #1,NR
  222. 8050 FOR J=1 TO NR: FOR I=0 TO 3: INPUT #1,R$(J,I): NEXT I,J
  223. 8060 CLOSE #1: RETURN
  224. 8100 REM ===> Write Maillist File (.LST)
  225. 8110 OPEN R$(D,0)+".LST" FOR OUTPUT AS #1
  226. 8120 PRINT: PRINT"STORING FILE "R$(D,0)
  227. 8130 PRINT #1,NR
  228. 8140 FOR J=1 TO NR: FOR I=1 TO 7
  229. 8150  PRINT #1,N$(J,I)
  230. 8160 NEXT I,J: CLOSE #1: RETURN
  231. 8200 REM ===> Write Listname File
  232. 8220 OPEN "LISTNAME" FOR OUTPUT AS #1
  233. 8230 PRINT #1,NR
  234. 8240 FOR J=1 TO NR: FOR I=0 TO 3: PRINT #1,R$(J,I): NEXT I,J
  235. 8250 CLOSE #1: RETURN
  236. 8300 REM ===> Delete a File
  237. 8310 PRINT"FILE "FL$+FE$;
  238. 8320 ON ERROR GOTO 8340
  239. 8330 KILL FL$+FE$: PRINT" DELETED": GOTO 8350
  240. 8340 PRINT" NOT FOUND": RESUME 8350   'target of error
  241. 8350 ON ERROR GOTO 0: RETURN
  242. 9200 REM ===> Subroutine to erase a line
  243. 9210 RWLC=CSRLIN-1: LOCATE RWLC,1: PRINT SPC(50);
  244. 9220 LOCATE RWLC,1: BEEP: RETURN
  245. 9400 CLOSE: RUN
  246. 9500 END
  247. 9999 REM ===> Dummy line for RENUM
  248. OCATE RWLC,1: PRINT SPC(50);
  249. 9220 LOCATE RWLC,1: BEEP: RETURN
  250. 9400 CLOSE: RUN
  251. 95